home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / MoDE / DispObj-Shan.st < prev    next >
Text File  |  1993-07-24  |  31KB  |  1,069 lines
  1. Line subclass: #MMSLine
  2.     instanceVariableNames: 'color '
  3.     classVariableNames: ''
  4.     poolDictionaries: ''
  5.     category: 'DispObj-Shan'!
  6.  
  7.  
  8. !MMSLine methodsFor: 'displaying'!
  9.  
  10. displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm 
  11.     "Privide the ability to write on an OpaqueForm.  Chage the semantics  
  12.      of instance var 'form' in this class.  It is always a black form of the  
  13.      line width.  The color of the line is stored in 'color'.  Shan May 8,   
  14.     1989"
  15.     "IMPROTANT: Any change here should be duplicated to MMSCircle.  I 
  16.     wish we have multiple inheritance here."
  17.  
  18.     | f |
  19.     (aDisplayMedium isKindOf: OpaqueForm)
  20.         ifTrue: 
  21.             ["Buffering action.  Display self with black color on a form and  
  22.              than use that form to display self on an OpaqueForm."
  23.             "The usage of super here is tricky.  Miss one, every thing  
  24.             won't work.  Shan May 8, 1989"
  25.             f _ Form extent: aDisplayMedium extent.  "May look costly. Actually not."
  26.             super
  27.                 displayOn: f
  28.                 at: aPoint
  29.                 clippingBox: clipRect
  30.                 rule: anInteger
  31.                 mask: Form black.
  32.             f
  33.                 displayOn: aDisplayMedium shape
  34.                 at: 0 @ 0
  35.                 rule: Form under.
  36.             f
  37.                 displayOn: aDisplayMedium figure
  38.                 at: 0 @ 0
  39.                 clippingBox: DisplayScreen boundingBox
  40.                 rule: Form paint
  41.                 mask: color]
  42.         ifFalse: [super
  43.                 displayOn: aDisplayMedium
  44.                 at: aPoint
  45.                 clippingBox: clipRect
  46.                 rule: anInteger
  47.                 mask: color]!
  48.  
  49. displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle 
  50.     "This is here to make use of the displaying method that understands 
  51.     transformation defined in the Path class.  Shan March 23, 1989"
  52.  
  53.     super
  54.         displayOn: aDisplayMedium
  55.         transformation: displayTransformation
  56.         clippingBox: clipRectangle
  57.         rule: Form over
  58.         mask: color! !
  59.  
  60. !MMSLine methodsFor: 'accessing'!
  61.  
  62. color: aMask
  63.     "Shan May 8, 1989"
  64.  
  65.     color _ aMask! !
  66.  
  67. !MMSLine methodsFor: 'transforming'!
  68.  
  69. scaleBy: aPoint 
  70.     "Pass on the color.  Shan June 24, 1989"
  71.  
  72.     ^(super scaleBy: aPoint) color: color!
  73.  
  74. translateBy: aPoint 
  75.     "Pass on the color.  Shan June 24, 1989"
  76.  
  77.     ^(super translateBy: aPoint) color: color! !
  78. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  79.  
  80. MMSLine class
  81.     instanceVariableNames: ''!
  82.  
  83.  
  84. !MMSLine class methodsFor: 'instance creation'!
  85.  
  86. from: f to: t 
  87.     "Shan July 29, 1989"
  88.  
  89.     ^self
  90.         from: f
  91.         to: t
  92.         width: 1
  93.         color: Form black!
  94.  
  95. from: f to: t width: w color: aMask 
  96.     "To separate the color attribute and the width attribute.  Width can  
  97.     be a point or an integer. Shan May 8, 1989"
  98.     "We have to stroe color as an inst var instead of using the 'form' (the 
  99.     brush) defined in Path class because the line needs to be able to 
  100.     display itself on an OpaqueForm.  See 'displayOn: at: clippingBox: rule: 
  101.     mask:'.  Shan June 24, 1989"
  102.  
  103.     | pt line |
  104.     pt _ w asPoint.
  105.     line _ super
  106.                 from: f
  107.                 to: t
  108.                 withForm: (Form extent: pt) black.
  109.     line color: aMask.
  110.     ^line! !
  111.  
  112. LinearFit subclass: #MMSLinearFit
  113.     instanceVariableNames: 'color '
  114.     classVariableNames: ''
  115.     poolDictionaries: ''
  116.     category: 'DispObj-Shan'!
  117.  
  118.  
  119. !MMSLinearFit methodsFor: 'displaying'!
  120.  
  121. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm
  122.     "Display the receiver on the display medium aDisplayMedium positioned at aDisplayPoint within 
  123.     the rectangle clipRectangle and with the rule, ruleInteger, and mask, aForm. "
  124.  
  125.     | line |
  126.     "line _ Line new. The only change.  Shan February 26, 1990"
  127.     line _ MMSLine new.
  128.     line form: self form.
  129.     line color: self color. "Shan 11 May 1990"
  130.     1 to: self size - 1 do: 
  131.         [:i | 
  132.         line beginPoint: (self at: i).
  133.         line endPoint: (self at: i + 1).
  134.         line displayOn: aDisplayMedium
  135.             at: aDisplayPoint
  136.             clippingBox: clipRectangle
  137.             rule: ruleInteger
  138.             mask: aForm]!
  139.  
  140. displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle 
  141.     "This is here to make use of the displaying method that understands 
  142.     transformation defined in the Path class.  Shan March 23, 1989"
  143.  
  144.     "If all the displayObject behave this way, Go fix the Path class."
  145.  
  146.     super
  147.         displayOn: aDisplayMedium
  148.         transformation: displayTransformation
  149.         clippingBox: clipRectangle
  150.         rule: Form over
  151.         mask: Form black! !
  152.  
  153. !MMSLinearFit methodsFor: 'accessing'!
  154.  
  155. color 
  156.     "Shan 11 May 1990"
  157.  
  158.     ^color!
  159.  
  160. color: f 
  161.     "Shan 11 May 1990"
  162.  
  163.     color _ f!
  164.  
  165. width: w 
  166.     "Shan 11 May 1990"
  167.  
  168.     self form: (Form extent: w asPoint) black! !
  169.  
  170. !MMSLinearFit methodsFor: 'transforming'!
  171.  
  172. scaleBy: aPoint 
  173.     "Pass on the color.  Shan 15 May 1990"
  174.  
  175.     ^(super scaleBy: aPoint) color: color!
  176.  
  177. translateBy: aPoint 
  178.     "Pass on the color.  Shan 15 May 1990"
  179.  
  180.     ^(super translateBy: aPoint) color: color! !
  181. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  182.  
  183. MMSLinearFit class
  184.     instanceVariableNames: ''!
  185.  
  186.  
  187. !MMSLinearFit class methodsFor: 'testing'!
  188.  
  189. linearFitSample
  190.     "Test color linearFit.  Shan 11 May 1990" 
  191.  
  192.     "MMSLinearFit linearFitSample."
  193.  
  194.     | aLinearFit aForm flag |
  195.     aLinearFit _ MMSLinearFit new.
  196.     aForm _ Form new extent: 10 @ 10.
  197.     aForm  black.
  198.     aLinearFit form: aForm.
  199. aLinearFit color: Form gray.
  200.     flag _ true.
  201.     [flag] whileTrue:
  202.         [Sensor waitButton.
  203.          Sensor redButtonPressed
  204.             ifTrue: [aLinearFit add: Sensor waitButton. Sensor waitNoButton.
  205.                     aForm displayOn: Display at: aLinearFit last]
  206.             ifFalse: [flag_false]].
  207.     aLinearFit displayOn: Display! !
  208.  
  209. DisplayObject subclass: #MMSStar
  210.     instanceVariableNames: ''
  211.     classVariableNames: ''
  212.     poolDictionaries: ''
  213.     category: 'DispObj-Shan'!
  214.  
  215.  
  216. !MMSStar methodsFor: 'displaying'!
  217.  
  218. displayOn: aDisplay transformation: aTrans clippingBox: anInsetDispBox 
  219.     "This is part of the example in class WindowNode.  Shan March 23, 
  220.     1989 "
  221.  
  222.     | form1 pen formRect |
  223.     formRect _ anInsetDispBox.
  224.     pen _ Pen new.
  225.     pen defaultNib: 2.
  226.     pen destForm: aDisplay.
  227.     aDisplay fill: formRect mask: Form white.
  228.     pen north; turn: 72 / 6 * 1; place: formRect center; spiral: 45 angle: 144! !
  229.  
  230. !MMSStar methodsFor: 'display box access'!
  231.  
  232. computeBoundingBox
  233.     "Shan March 28, 1989"
  234.  
  235.     ^ 0@0 extent: 50@50! !
  236.  
  237. Circle subclass: #MMSCircle
  238.     instanceVariableNames: 'color '
  239.     classVariableNames: ''
  240.     poolDictionaries: ''
  241.     category: 'DispObj-Shan'!
  242.  
  243.  
  244. !MMSCircle methodsFor: 'displaying'!
  245.  
  246. displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm 
  247.     "This is a duplicate of the method in MMSLine.  Shan May 8, 1989"
  248.  
  249.     | f |
  250.     (aDisplayMedium isKindOf: OpaqueForm)
  251.         ifTrue: 
  252.             ["Buffering action.  Display self with black color on a form and  
  253.              than use that form to display self on an OpaqueForm."
  254.             "The usage of super here is tricky.  Miss one, every thing  
  255.             won't work.  Shan May 8, 1989"
  256.             f _ Form extent: aDisplayMedium extent.
  257.             super
  258.                 displayOn: f
  259.                 at: aPoint
  260.                 clippingBox: clipRect
  261.                 rule: anInteger
  262.                 mask: Form black.
  263.             f
  264.                 displayOn: aDisplayMedium shape
  265.                 at: 0 @ 0
  266.                 rule: Form under.
  267.             f
  268.                 displayOn: aDisplayMedium figure
  269.                 at: 0 @ 0
  270.                 clippingBox: DisplayScreen boundingBox
  271.                 rule: Form paint
  272.                 mask: color]
  273.         ifFalse: [super
  274.                 displayOn: aDisplayMedium
  275.                 at: aPoint
  276.                 clippingBox: clipRect
  277.                 rule: anInteger
  278.                 mask: color]!
  279.  
  280. displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle 
  281.     "This is here to make use of the displaying method that understands  
  282.     transformation defined in the Path class.  Shan March 23, 1989"
  283.     "If all the displayObject behave this way, Go fix the Path class. 
  284.     DON'T. This method also make the MMSCircle use its own color.  
  285.     Shan June 24, 1989"
  286.  
  287.     super
  288.         displayOn: aDisplayMedium
  289.         transformation: displayTransformation
  290.         clippingBox: clipRectangle
  291.         rule: Form over
  292.         mask: color! !
  293.  
  294. !MMSCircle methodsFor: 'accessing'!
  295.  
  296. color: aMask
  297.     color _ aMask!
  298.  
  299. width: w
  300.     "Separate the width from the color.  Shan May 8, 1989"
  301.  
  302.     self form: (Form extent: w asPoint) black! !
  303.  
  304. !MMSCircle methodsFor: 'transforming'!
  305.  
  306. scaleBy: aPoint 
  307.     "Pass on the color.  Shan June 24, 1989"
  308.  
  309.     ^(super scaleBy: aPoint) color: color!
  310.  
  311. translateBy: aPoint 
  312.     "Pass on the color.  Shan June 24, 1989"
  313.  
  314.     ^(super translateBy: aPoint) color: color! !
  315. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  316.  
  317. MMSCircle class
  318.     instanceVariableNames: ''!
  319.  
  320.  
  321. !MMSCircle class methodsFor: 'instance creation'!
  322.  
  323. new
  324.     "Initialize the color.  Shan June 24, 1989"
  325.  
  326.     ^super new color: Form black! !
  327.  
  328. Spline subclass: #MMSSpline
  329.     instanceVariableNames: ''
  330.     classVariableNames: ''
  331.     poolDictionaries: ''
  332.     category: 'DispObj-Shan'!
  333. MMSSpline comment:
  334. 'This class has not been modified for displaying on an OpaqueForm.  Shan June 24, 1989.
  335. Wait for the color version of Smalltalk 80!!'!
  336.  
  337.  
  338. !MMSSpline methodsFor: 'displaying'!
  339.  
  340. displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger mask: aForm 
  341.     "Check the derivatives.  After ther transformation, a new spline is 
  342.     created.  Derivatives of the newly created spline is still empty.  See 
  343.     Path 'displayOn: transformation: clippingBox: rule: mask:'. Shan June 
  344.     24, 1989"
  345.  
  346.     derivatives isNil ifTrue: [self computeCurve].
  347.     super
  348.         displayOn: aDisplayMedium
  349.         at: aPoint
  350.         clippingBox: clipRect
  351.         rule: anInteger
  352.         mask: aForm!
  353.  
  354. displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle 
  355.     "This is here to make use of the displaying method that understands 
  356.     transformation defined in the Path class.  Shan March 23, 1989"
  357.  
  358.     "If all the displayObject behave this way, Go fix the Path class."
  359.  
  360.     super
  361.         displayOn: aDisplayMedium
  362.         transformation: displayTransformation
  363.         clippingBox: clipRectangle
  364.         rule: Form over
  365.         mask: Form black! !
  366.  
  367. DisplayObject subclass: #MDisplayObject
  368.     instanceVariableNames: 'contents insideColor borderWidth borderColor form boundingBox '
  369.     classVariableNames: ''
  370.     poolDictionaries: ''
  371.     category: 'DispObj-Shan'!
  372. MDisplayObject comment:
  373. 'There are two kinds of bahavior for DispObj.  When the boundingBox is nil, a DispObj will not scale the contents when outputting.  When the boundingBox is not nil, it will scale the output according to the differrence of the ''unclippedDispBox'' from the mode and the boundingBox.  
  374. Stretchable modes like LineMode should make the boundingBox notNil.  Shan May 12, 1989'!
  375.  
  376.  
  377. !MDisplayObject methodsFor: 'transforming'!
  378.  
  379. translateBy: aPoint 
  380.     "Translate all objects in the contents. Special treatment is needed 
  381.     because some DisplayObejct returns a new instance instead of 
  382.     changing the old instance when issued a translateBy: message. 
  383.     Path, for example. Shan March 7, 1990"
  384.  
  385.     | newCont |
  386.     newCont _ OrderedCollection new.
  387.     contents do: [:each | newCont add: (each translateBy: aPoint)].
  388.     contents _ newCont! !
  389.  
  390. !MDisplayObject methodsFor: 'initialize-release'!
  391.  
  392. initialize
  393.     "Contents is the collection that stores the display objects.  Shan   
  394.     March 24, 1989"
  395.  
  396.     contents _ OrderedCollection new: 1.
  397.     borderWidth _ 0.
  398.     borderColor _ Form black! !
  399.  
  400. !MDisplayObject methodsFor: 'accessing'!
  401.  
  402. absAdd: aDisplayObject 
  403.     "No offset of borderWidth. When the 'aDisplayObject' does not 
  404.     understand #offset, use this one. (For example, MMSStar.) This 
  405.     method is for the majority of use; 'relAdd:' is added for convenience. 
  406.     Shan December 4, 1989"
  407.  
  408.     contents add: aDisplayObject.
  409.     form notNil ifTrue: ["Unbuffer the form. Shan September 17, 1989"
  410.         form _ Form extent: 0 @ 0]!
  411.  
  412. add: aDisplayObject 
  413.     "Obselete. Replaced by 'relAdd:' and 'absAdd:' Shan December 4, 
  414.     1989"
  415.  
  416.     ^self error: 'Should use "relAdd:" or absAdd:"'!
  417.  
  418. borderColor
  419.     ^borderColor!
  420.  
  421. borderColor: aColor 
  422.     "Disable the buffering since the appearance has been changed.  This   
  423.     is not used in highlighting since the highlight of border is drastically 
  424.     slow down by having to rebuffering the image for every highlight and   
  425.     deHighlight.  Shan July 17, 1989"
  426.  
  427.     form notNil ifTrue: [form _ Form extent: 0 @ 0].
  428.     borderColor _ aColor!
  429.  
  430. borderColorTemp: aColor 
  431.     "This is specifically for highlights.  By pass the buffer mechanism. 
  432.     Shan July 17, 1989"
  433.  
  434.     borderColor _ aColor!
  435.  
  436. borderWidth
  437.     ^borderWidth!
  438.  
  439. borderWidth: aWidth 
  440.     form notNil ifTrue: [form _ Form extent: 0@0].
  441.     borderWidth _ aWidth!
  442.  
  443. borderWidthTemp: aWidth 
  444.     borderWidth _ aWidth!
  445.  
  446. clear
  447.     "Shan July 23, 1989"
  448.  
  449.     contents removeAllSuchThat: [:dummy | true].
  450.     "This is important for titleBars where the dispObj and highlightDispObj share the same collection.  Shan January 12, 1990"
  451.     "Unbuffer the form. Shan September 17, 1989"
  452.     form notNil ifTrue: [form _ Form extent: 0 @ 0]!
  453.  
  454. contents
  455.     "This is to allow the OddShapeModes to access my contents so that 
  456.     they can compute the sensitive region.    Shan May 7, 1989"
  457.  
  458.     ^contents!
  459.  
  460. insideColor
  461.     ^insideColor!
  462.  
  463. relAdd: aDisplayObject 
  464.     "This is an relative add which take into account the origin of 
  465.     borderWidth by offsetting the input object. There are times when 
  466.     we want to add objects according to the corner of the DispObj. 
  467.     This method does not help at all. Shan November 30, 1989"
  468.     "aDisplayObject that is not a Path and does not implement 'offset' can
  469.     not use this method.  Shan December 3, 1989"
  470.  
  471.     | offset dObj |
  472.     dObj _ aDisplayObject.
  473.     (borderWidth isKindOf: Rectangle)
  474.         ifTrue: [offset _ borderWidth origin]
  475.         ifFalse: [offset _ borderWidth].
  476.     (aDisplayObject isKindOf: DisplayObject)
  477.         ifTrue: [(aDisplayObject isKindOf: Path)
  478.                 ifTrue: [dObj _ aDisplayObject translateBy: offset asPoint]
  479.                 ifFalse: [dObj _ aDisplayObject offset: aDisplayObject offset + offset]]
  480.         ifFalse: ["There are object like Quandrangle which does not 
  481.             understand 'offset' at all"
  482.             (aDisplayObject isKindOf: Quadrangle)
  483.                 ifTrue: [dObj _ aDisplayObject translateBy: offset]].
  484.     contents add: dObj.
  485.     form notNil ifTrue: ["Unbuffer the form. Shan September 17, 1989"
  486.         form _ Form extent: 0 @ 0]! !
  487.  
  488. !MDisplayObject methodsFor: 'inversion'!
  489.  
  490. inverse
  491.  
  492.     "form reverse"
  493.     self inverse: self boundingBox!
  494.  
  495. inverse: ext
  496.     "Using the rule reverse from Form does not work because the contents 
  497.      objects treat the rule differently than I thought.  I have to 
  498.     abandent this way and use a form to do the job.  Wait for a better display  
  499.     mechanism provided by ParcPlac.  Shan May 28, 1989"
  500.     "Add the argument ext.  Shan July 25, 1989"
  501.  
  502.     (form isNil or: [form extent = (0 @ 0)])
  503.         ifTrue: [self bufferWithExtent: ext].
  504.     "The form can be a Form which inherits the 'reverse' method from the  
  505.     DisplayMedium; or a MMSOpaueForm.  Shan May 29, 1989"
  506.     form reverse! !
  507.  
  508. !MDisplayObject methodsFor: 'displaying'!
  509.  
  510. borderWithUnClippedDispBox: unclippedDispBox visibleRects: visibleRects 
  511.     "This one does not handle the ood shaped modes.  Shan April 5, 1989"
  512.  
  513.     (borderWidth ~= 0)
  514.         ifTrue: [visibleRects do: [:eachRect | Display
  515.                     border: unclippedDispBox
  516.                     widthRectangle: borderWidth
  517.                     mask: borderColor
  518.                     clippingBox: eachRect]]!
  519.  
  520. displayAt: aPoint
  521.     "This method currently serves as a test method only.  Shan March 
  522.     28, 1989"
  523.  
  524.     self displayOn: Display at: aPoint!
  525.  
  526. displayContentsOn: aMedia transformation: aTrans clippingBox: aVisibleRect 
  527.     "Shan March 23, 1989"
  528.  
  529.     contents do: [:each | each
  530.             displayOn: aMedia
  531.             transformation: aTrans
  532.             clippingBox: aVisibleRect]!
  533.  
  534. displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
  535.     "Implement the display primitive method defined in DisplayObject class. 
  536.        Shan April 5, 1989"
  537.  
  538.     | box |
  539.     (form isNil or: [form extent = (0 @ 0)])
  540.         ifTrue: [box _ self boundingBox]
  541.         ifFalse: [box _ form boundingBox].
  542.     box _ box moveTo: aDisplayPoint.
  543.     self
  544.         displayOn: aDisplayMedium
  545.         withUnClippedDispBox: box
  546.         visibleRects: (OrderedCollection with: (clipRectangle intersect: box))!
  547.  
  548. displayOn: aMedium withUnClippedDispBox: unclippedDispBox visibleRects: visibleRects 
  549.     "Take the unclipped displayBox of a mode and visibleRects, draw self  
  550.       in the visible rects.  Shan March 28, 1989"
  551.  
  552.     | aTrans insetRect insetDispBox |
  553.     form notNil ifTrue: ["I buffer bits to draw faster"
  554.         ^self
  555.             fastDisplayOn: aMedium
  556.             withUnClippedDispBox: unclippedDispBox
  557.             visibleRects: visibleRects].
  558.     "Normal unbuffered draw."
  559.     aTrans _ self computeTransformation: unclippedDispBox.
  560.     "Shan November 21, 1989 aTrans _ self computeInsetTransformation: unclippedDispBox." 
  561. "Transcript cr; show: aTrans printString."
  562.     "For computing the insetVisibleRects."
  563.     insetDispBox _ unclippedDispBox insetBy: borderWidth.
  564.     "Now draw!!"
  565.     borderWidth = 0
  566.         ifTrue: [insideColor == nil
  567.                 ifTrue: [visibleRects do: [:eachRect | self
  568.                             displayContentsOn: aMedium
  569.                             transformation: aTrans
  570.                             clippingBox: (eachRect intersect: insetDispBox)]]
  571.                 ifFalse: [visibleRects do: 
  572.                         [:eachRect | 
  573.                         aMedium fill: eachRect mask: insideColor.
  574.                         self
  575.                             displayContentsOn: aMedium
  576.                             transformation: aTrans
  577.                             clippingBox: (eachRect intersect: insetDispBox)]]]
  578.         ifFalse: [insideColor == nil
  579.                 ifTrue: [visibleRects do: 
  580.                         [:eachRect | 
  581.                         aMedium
  582.                             border: unclippedDispBox
  583.                             widthRectangle: borderWidth
  584.                             mask: borderColor
  585.                             clippingBox: eachRect.
  586.                         self
  587.                             displayContentsOn: aMedium
  588.                             transformation: aTrans
  589.                             clippingBox: (eachRect intersect: insetDispBox)]]
  590.                 ifFalse: [visibleRects do: 
  591.                         [:eachRect | 
  592.                         aMedium fill: eachRect mask: borderColor.
  593.                         insetRect _ eachRect intersect: insetDispBox.
  594.                         aMedium fill: insetRect mask: insideColor.
  595.                         self
  596.                             displayContentsOn: aMedium
  597.                             transformation: aTrans
  598.                             clippingBox: insetRect]]]!
  599.  
  600. displayWithUnClippedDispBox: unclippedDispBox visibleRects: visibleRects 
  601.     self
  602.         displayOn: Display
  603.         withUnClippedDispBox: unclippedDispBox
  604.         visibleRects: visibleRects!
  605.  
  606. fastDisplayOn: aMedium withUnClippedDispBox: unclippedDispBox visibleRects: visibleRects 
  607.     "Use the form to display.  Shan March 28, 1989"
  608.     "Check the buffered bits are up to date."
  609.  
  610.     | aTrans | 
  611.     form extent = unclippedDispBox extent ifFalse: ["Update the buffer"
  612.         self bufferWithExtent: unclippedDispBox extent].
  613.     aTrans _ self computeFormTransformation: unclippedDispBox.
  614.     visibleRects do: [:each | form
  615.             displayOn: aMedium
  616.             transformation: aTrans
  617.             clippingBox: each]! !
  618.  
  619. !MDisplayObject methodsFor: 'buffering'!
  620.  
  621. bufferWithExtent: ext 
  622.     "I buffer my self in a form and use the form to draw faster.  The ext   
  623.       specifies the extent of the unclipped display box.  It is needed to    
  624.      calculate the bordering.  Shan March 28, 1989"
  625.     "Now it handles colors.  Shan May 8, 1989"
  626.  
  627.     | box f t |
  628.     self unBuffer.
  629.     box _ 0 @ 0 extent: ext.
  630.     insideColor isNil
  631.         ifTrue: [f _ MMSOpaqueForm figure: (Form extent: ext)
  632.                         shape: ((Form extent: ext)
  633.                                 fill: (0 @ 0 extent: ext)
  634.                                 rule: Form over
  635.                                 mask: Form white)]
  636.         ifFalse: [f _ Form extent: ext]. 
  637.     self
  638.         displayOn: f
  639.         withUnClippedDispBox: box
  640.         visibleRects: (OrderedCollection with: box).
  641.     form _ f!
  642.  
  643. makeAbsoluteFaster
  644.     "Make form non-nil to trigger the buffering mechanism.  This one 
  645.     doesn't care whether what is in the contents or whether my 
  646.     background color is nil.  It just buffers.  Under normal condition the 
  647.     'makeFaster' is recommended.  Shan  March 29, 1989"
  648.  
  649.     form isNil ifTrue: [form _ Form extent: 0 @ 0]!
  650.  
  651. makeFaster
  652.     "Buffer bits only when the contents contain display objects other 
  653.     than Form and Text.  That is a Paths (lines, circles, drawings).  Make 
  654.     form non-nil to trigger the buffering mechanism.  Shan  March  
  655.     29, 1989"
  656.  
  657.     contents detect: [:each | each isKindOf: Path]
  658.         ifNone: [^self].
  659.     self makeAbsoluteFaster!
  660.  
  661. unBuffer
  662.     "Unbuffer myself.  From now on, I no longer buffer bits.  Shan March 
  663.     29, 1989"
  664.  
  665.     "form nilFields.  Shan September 11, 1989"
  666.     form _ nil! !
  667.  
  668. !MDisplayObject methodsFor: 'testing'!
  669.  
  670. containsPoint: p 
  671.     "This is used for odd shape mode only. Shan May 31, 1989"
  672.     "Expanded to be used for paths. Shan March 3, 1990"
  673.  
  674.     form notNil ifTrue: ["Buffered path."
  675.         ^form containsPoint: p].
  676.     (contents size = 1 and: [contents first isKindOf: MMSOpaqueForm])
  677.         ifTrue: [^contents first containsPoint: p].
  678.     ^self boundingBox containsPoint: p! !
  679.  
  680. !MDisplayObject methodsFor: 'display box access'!
  681.  
  682. boundingBox
  683.     "Include the borderWidth.  Shan July 28, 1989"
  684.  
  685.     boundingBox isNil
  686.         ifTrue: [^self computeBoundingBox expandBy: borderWidth]
  687.         ifFalse: [^boundingBox]!
  688.  
  689. boundingBox: aBox
  690.     "Shan May 12, 1989"
  691.     boundingBox _ aBox!
  692.  
  693. computeBoundingBox
  694.     "Shan March 28, 1989"
  695.  
  696.     | box |
  697.     box _ 0 @ 0 extent: 0 @ 0. 
  698.     contents do: [:each | box _ each boundingBox merge: box].
  699.     "box extent ~= (0 @ 0)
  700.         ifTrue: [^box]
  701.         ifFalse: [^nil] Shan March3, 1990"
  702.     ^box! !
  703.  
  704. !MDisplayObject methodsFor: 'private'!
  705.  
  706. computeFormTransformation: unclippedDispBox 
  707.     "Compute the transformation to map the form (including the border) 
  708.     onto the screen display box.  Shan April 5, 1989"
  709.     "Shan November 30, 1989"
  710.  
  711.     ^WindowingTransformation scale: nil translation: unclippedDispBox origin!
  712.  
  713. computeInsetTransformation: unclippedDispBox 
  714.     "Compute the transformation to map the contents onto the screen    
  715.     display box.  Shan April 1, 1989"
  716.     "If the instance var 'boundingBox' is nil, no scaling.  Otherwise use it 
  717.     to scale.  Direct accessing the 'boundingBox' and 'self boundingBox' 
  718.     have different meanings.  When 'self boundingBox' returns nil, it 
  719.     means there is no contents; while 'boundingBox' is nil means no 
  720.     scaling when displaying.  Shan May 12, 1989"
  721.     "This is not used.  See comments in 'add:'.  Shan November 21, 1989"
  722.  
  723.     | translation |
  724.     boundingBox isNil
  725.         ifTrue: 
  726.             [(borderWidth isKindOf: Rectangle)
  727.                 ifTrue: [translation _ unclippedDispBox origin + borderWidth origin]
  728.                 ifFalse: [translation _ unclippedDispBox origin + borderWidth].
  729.             ^WindowingTransformation scale: nil translation: translation]
  730.         ifFalse: [^WindowingTransformation window: boundingBox viewport: (unclippedDispBox insetBy: borderWidth)]!
  731.  
  732. computeTransformation: unclippedDispBox 
  733.     "Compute the transformation to map the form (including the border) 
  734.     onto the screen display box.  Shan November 21, 1989"
  735.  
  736.     | translation |
  737.     boundingBox isNil
  738.         ifTrue: 
  739.             [translation _ unclippedDispBox origin.
  740.             ^WindowingTransformation scale: nil translation: translation]
  741.         ifFalse: [^WindowingTransformation window: boundingBox viewport: unclippedDispBox]!
  742.  
  743. insideColor: aColor 
  744.     "This should not be used directly.  Changing the inside color of a mode 
  745.     from nil to something may affect the layering.  The border and 
  746.     background should be considered as the attributes of mode.  Changes 
  747.     should be made through mode.  Shan April 12, 1989"
  748.  
  749.     form notNil ifTrue: [form _ Form extent: 0@0].
  750.     insideColor _ aColor! !
  751.  
  752. !MDisplayObject methodsFor: 'copying'!
  753.  
  754. deepCopy
  755.     "Avoid copying the 'contents' and the forms.  Shan  August 3, 1989"
  756.  
  757.     | newObject |
  758.     newObject _ self shallowCopy.
  759.     "So that the new and old object will have diff collection."
  760.     contents _ contents shallowCopy.
  761.     ^newObject! !
  762. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  763.  
  764. MDisplayObject class
  765.     instanceVariableNames: ''!
  766.  
  767.  
  768. !MDisplayObject class methodsFor: 'instence creation'!
  769.  
  770. new
  771.     "Shan March 23, 1989"
  772.  
  773.     ^ super new initialize! !
  774.  
  775. !MDisplayObject class methodsFor: 'testing'!
  776.  
  777. circleTest
  778.     "See if I can draw a circle.  Shan Mrach 23, 1989"
  779.     "DispObj circleTest"
  780.  
  781.     | dispObj circle |
  782.     dispObj _ MDisplayObject new.
  783.     circle _ MMSCircle new.
  784.     circle form: (Form extent: 2 @ 2) black.
  785.     circle radius: 20.
  786.     circle center: 20 @ 20.
  787.     dispObj absAdd: circle.
  788.     dispObj displayAt: 400 @ 400!
  789.  
  790. drawingOnOpqForm
  791.     "See if I can draw color drawings to an OpaqueForm and display them 
  792.      as I wanted.  Shan May 8, 1989"
  793.     "MDisplayObject drawingOnOpqForm"
  794.  
  795.     | line circle f |
  796.     f _ MMSOpaqueForm figure: (Form extent: 150 @ 150)
  797.                 shape: ((Form extent: 150 @ 150)
  798.                         fill: (0 @ 0 extent: 180 @ 150)
  799.                         rule: Form over
  800.                         mask: Form white).
  801.     circle _ MMSCircle new.
  802.     circle color: Form darkGray.
  803.     circle width: 3.
  804.     circle radius: 20.
  805.     circle center: 20 @ 20.
  806.     line _ MMSLine
  807.                 from: 0 @ 0
  808.                 to: 500 @ 50
  809.                 width: 8 @ 8 color: Form lightGray.
  810.     circle displayOn: f.
  811.     line displayOn: f.
  812.     f displayAt: 50@50!
  813.  
  814. fastLineTest
  815.     "See if I can draw a line.  Shan Mrach 28, 1989"
  816.     "MDisplayObject fastLineTest"
  817.  
  818.     | dispObj |
  819.     dispObj _ MDisplayObject new.
  820.     dispObj absAdd: (MMSLine
  821.             from: 0 @ 0
  822.             to: 500 @ 50
  823.             width: 2@2 color: Form black).
  824.     dispObj makeFaster.
  825.     dispObj displayAt: 100 @ 100!
  826.  
  827. fastStarTest
  828.     "See if I can draw a star.  Shan Mrach 23, 1989"
  829.     "MDisplayObject fastStarTest"
  830.  
  831.     | dispObj star |
  832.     dispObj _ MDisplayObject new.
  833.     star _ MMSStar new.
  834.     "If insideColor is nil, this won't work because Pen a subClass of BitBlt 
  835.     doesn't know how to draw on a OpaqueForm.  Shan May 8, 1989"
  836.     dispObj insideColor: Form white.
  837.     dispObj absAdd: star.
  838.     dispObj makeAbsoluteFaster.
  839.     dispObj displayAt: 100 @ 400!
  840.  
  841. inversePictureTest
  842.     "See if I can draw a inversePicture.  Shan Mrach 23, 1989"
  843.     "MDisplayObject inversePictureTest"
  844.  
  845.     | dispObj picture |
  846.     dispObj _ MDisplayObject new.
  847.     picture _ Form readFrom: 'forms/barry.i'.
  848.     dispObj relAdd: picture.
  849.     "For pictures the inside color must set to white.  Otherwise, the 
  850.     'bufferWithExtent:' method used in the 'inverse' will use a 
  851.     MMSOpaqueForm to buffer the picture instead of just a Form.  Shan 
  852.     May 29, 1989"
  853.     dispObj insideColor: Form white.
  854.     dispObj inverse.
  855.     dispObj displayAt: 800 @ 400!
  856.  
  857. lineTest
  858.     "See if I can draw a line.  Shan Mrach 23, 1989"
  859.     "MDisplayObject lineTest"
  860.  
  861.     | dispObj |
  862.     dispObj _ MDisplayObject new.
  863.     dispObj borderWidth: 0.
  864.     dispObj relAdd: (MMSLine
  865.             from: 0 @ 0
  866.             to: 500 @ 50
  867.             width: 2@2 color: Form black).
  868.     dispObj displayAt: 100 @ 10!
  869.  
  870. pictureTest
  871.     "See if I can draw a picture.  Shan Mrach 23, 1989"
  872.     "MDisplayObject pictureTest"
  873.  
  874.     | dispObj picture |
  875.     dispObj _ MDisplayObject new.
  876.     picture _ Form readFrom: 'forms/barry.i'.
  877.     dispObj relAdd: picture.
  878.     dispObj displayAt: 400 @ 400!
  879.  
  880. scalingTest
  881.     "Test the scaling ability.  Shan May 12, 1989"
  882.     "MDisplayObject scalingTest"
  883.  
  884.     | dispObj rect |
  885.     dispObj _ MDisplayObject new.
  886.     dispObj relAdd: (MMSLine
  887.             from: 0 @ 0
  888.             to: 500 @ 50
  889.             width: 2 @ 2
  890.             color: Form black).
  891.     "The 'boundingBox defines the rectangle that is to be mapped to the 
  892.     screen. "
  893.     dispObj boundingBox: (0 @ 0 extent: 400 @ 50).
  894.     rect _ 50 @ 50 extent: 100 @ 100.
  895.     dispObj displayWithUnClippedDispBox: rect visibleRects: (OrderedCollection with: rect)!
  896.  
  897. starTest
  898.     "See if I can draw a star.  Shan Mrach 23, 1989"
  899.     "MDisplayObject starTest"
  900.  
  901.     | dispObj star |
  902.     dispObj _ MDisplayObject new.
  903.     star _ MMSStar new.
  904.     dispObj absAdd: star.
  905.     dispObj displayAt: 400 @ 400!
  906.  
  907. textTest
  908.     "See if I can draw a text.  Shan Mrach 23, 1989"
  909.     "MDisplayObject textTest"
  910.  
  911.     | dispObj text |
  912.     dispObj _ MDisplayObject new.
  913.     text _ 'This is a tow line
  914. text to display' asDisplayText.
  915.     "text offset: 10 @ 10."
  916.     dispObj relAdd: text.
  917.     dispObj displayAt: 400 @ 400! !
  918.  
  919. MDisplayObject subclass: #AnimationDispObj
  920.     instanceVariableNames: 'displayProcess millisecondsPerFrame '
  921.     classVariableNames: 'RotatingStar '
  922.     poolDictionaries: ''
  923.     category: 'DispObj-Shan'!
  924.  
  925.  
  926. !AnimationDispObj methodsFor: 'buffering'!
  927.  
  928. bufferWithExtent: ext 
  929.     "An animation display object does not need to be buffered. Shan May 
  930.     31, 1989"
  931.  
  932.     ^self! !
  933.  
  934. !AnimationDispObj methodsFor: 'displaying'!
  935.  
  936. displayOn: aMedium withUnClippedDispBox: unclippedDispBox visibleRects: visibleRects 
  937.     "When I am displayed on the Display, run the animation loop. If not, I 
  938.     am used as a ordinary display object in creating a form. Do not 
  939.     execute the animation loop. Shan May 31, 1989"
  940.     "Do not depend on that the highlight and dehighlight will be paired. 
  941.     Shan September 30, 1989"
  942.  
  943.     | delay |
  944.     aMedium == Display
  945.         ifTrue: 
  946.             [delay _ Delay forMilliseconds: millisecondsPerFrame.
  947.             "Stop the previous loop if it exists. Shan September 30"
  948.             self stopDisplayLoop.
  949.             displayProcess _ [[true]
  950.                         whileTrue: 
  951.                             [super
  952.                                 displayOn: aMedium
  953.                                 withUnClippedDispBox: unclippedDispBox
  954.                                 visibleRects: visibleRects.
  955.                             delay wait]] newProcess.
  956.             displayProcess resume]
  957.         ifFalse: [super
  958.                 displayOn: aMedium
  959.                 withUnClippedDispBox: unclippedDispBox
  960.                 visibleRects: visibleRects]!
  961.  
  962. stopDisplayLoop
  963.     "Shan September 30, 1989"
  964.  
  965.     displayProcess notNil
  966.         ifTrue: 
  967.             [displayProcess terminateNoSignal.
  968.             displayProcess _ nil]! !
  969.  
  970. !AnimationDispObj methodsFor: 'initialize'!
  971.  
  972. initialize
  973.     super initialize.
  974.     millisecondsPerFrame _ 80.! !
  975.  
  976. !AnimationDispObj methodsFor: 'access'!
  977.  
  978. millisecondsPerFrame
  979.     ^millisecondsPerFrame!
  980.  
  981. millisecondsPerFrame: s 
  982.     "Shan May 31, 1989"
  983.  
  984.     millisecondsPerFrame _ s! !
  985.  
  986. !AnimationDispObj methodsFor: 'testing'!
  987.  
  988. containsPoint: p 
  989.     "This is used for odd shape mode only.  An animation display object 
  990.     always contains the point when asked.  The point has already been 
  991.     screened by mode.  Since the animation forms can be arbitrary 
  992.     shape, if we use the method implemented in DispObj, events may be 
  993.     lost.  Shan May 31, 1989"
  994.  
  995.     ^true! !
  996. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  997.  
  998. AnimationDispObj class
  999.     instanceVariableNames: ''!
  1000.  
  1001.  
  1002. !AnimationDispObj class methodsFor: 'access'!
  1003.  
  1004. rotatingStar
  1005.     "Shan July 31, 1989"
  1006.  
  1007.     | f pen formRect scratchF |
  1008.     RotatingStar isNil
  1009.         ifTrue: 
  1010.             [formRect _ 0 @ 0 extent: 50 @ 50.
  1011.             pen _ Pen new.
  1012.             pen defaultNib: 2.
  1013.             f _ MMSSequenceNode subNodes: ((1 to: 5)
  1014.                             collect: 
  1015.                                 [:n | 
  1016.                                 scratchF _ (Form extent: 50 @ 50) white.
  1017.                                 pen destForm: scratchF.
  1018.                                 pen north; turn: 72 / 6 * n; place: formRect center; spiral: 45 angle: 144.
  1019.                                 scratchF]).
  1020.             RotatingStar _ self new absAdd: f
  1021.             "RotatingStar boundingBox: (0@0 corner: 60@60) This does 
  1022.             not work since the setting of the boundingBox will force the 
  1023.             DispObj to scale when displaying the animation object.  Shan 
  1024.             July 29, 1989"].
  1025.     ^RotatingStar! !
  1026.  
  1027. DisplayObject subclass: #MMSSequenceNode
  1028.     instanceVariableNames: 'subNodes position '
  1029.     classVariableNames: ''
  1030.     poolDictionaries: ''
  1031.     category: 'DispObj-Shan'!
  1032.  
  1033.  
  1034. !MMSSequenceNode methodsFor: 'access'!
  1035.  
  1036. boundingBox
  1037.     ^ subNodes first boundingBox!
  1038.  
  1039. offset
  1040.     ^ 0@0! !
  1041.  
  1042. !MMSSequenceNode methodsFor: 'displaying'!
  1043.  
  1044. displayOn: destForm at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm
  1045.      subNodes size < 1 ifTrue: [^self].
  1046.     position _ position + 1.
  1047.     position > subNodes size ifTrue: [position _ 1].
  1048.     (subNodes at: position)
  1049.         displayOn: destForm at: aDisplayPoint clippingBox: clipRectangle
  1050.         rule: ruleInteger mask: aForm! !
  1051.  
  1052. !MMSSequenceNode methodsFor: 'private'!
  1053.  
  1054. setNodes: nodeCollection index: anInteger
  1055.     subNodes _ nodeCollection.
  1056.     position _ anInteger! !
  1057. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1058.  
  1059. MMSSequenceNode class
  1060.     instanceVariableNames: ''!
  1061.  
  1062.  
  1063. !MMSSequenceNode class methodsFor: 'subNodes'!
  1064.  
  1065. subNodes: aCollection
  1066.     ^ self subNodes: aCollection index: 1!
  1067.  
  1068. subNodes: aCollection index: index
  1069.     ^ self new setNodes: aCollection index: index! !